home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 09 / 1 / DISK0914.ZIP / BLD_PIC.PAS next >
Pascal/Delphi Source File  |  1987-04-15  |  5KB  |  160 lines

  1. PROGRAM Pic_Bld;
  2. { CONVERTS FILES FROM BASIC BLOAD FORMAT TO PC-DEMO .PIC FORMAT }
  3.  
  4.   CONST
  5.     Columns40           = 40;       { COLUMNS FROM 1 TO 40 }
  6.     Columns80           = 80;       { COLUMNS FROM 1 TO 80 }
  7.     LastLine            = 25;       { LINES FROM 1 TO 25 }
  8.     MaxtString          = 76;       { MAX CHARS IN FILE NAME W/ PATH AND EXT }
  9.     FourKB              = 4000;     { FILE SIZE OF 80-COLUMN PICTURE }
  10.     TwoKB               = 2000;     { FILE SIZE OF 40-COLUMN PICTURE }
  11.     Page40              = 2048;     { OFFSET FOR MULTIPLE PAGES IN 40-COL }
  12.     Page80              = 4096;     { OFFSET FOR MULTIPLE PAGES IN 80-COL }
  13.     BloadCode           = 253;      { FIRST BYTE OF A .BLD FILE }
  14.     EndOfFile           = 026;      { ASCII CODE FOR END OF FILE IN .BLD FILE }
  15.     BloadExt            = '.BLD';   { FILE EXTENSION FOR BLOAD FILES }
  16.     PictureExt          = '.PIC';   { FILE EXTENSION FOR FULL PICTURES }
  17.     Null                = '';       { NULL STRING }
  18.  
  19.   TYPE
  20.     N_PictureType       = ARRAY [1..LastLine, 1..Columns40] OF Integer;
  21.                                     { ARRAY OF 40-COLUMN PICTURE DATA }
  22.     W_PictureType       = ARRAY [1..LastLine, 1..Columns80] OF Integer;
  23.                                     { ARRAY OF 80-COLUMN PICTURE DATA }
  24.  
  25.     N_BloadType         = ARRAY [1..Page40] OF Byte;
  26.                                     { ARRAY OF 40-COLUMN BLOAD FILE DATA }
  27.     W_BloadType         = ARRAY [1..Page80] OF Byte;
  28.                                     { ARRAY OF 80-COLUMN BLOAD FILE DATA }
  29.  
  30.     ParString           = String [255];
  31.                                     { VARIABLE LENGTH STRING PARAMETER TYPE }
  32.  
  33.   VAR
  34.     Code,
  35.     HighLength,
  36.     I,
  37.     LowLength          : Byte;
  38.  
  39.     Size               : Integer;
  40.  
  41.     IName,
  42.     OName              : ParString;
  43.  
  44.     W_Picture          : W_PictureType;
  45.                                     { THE 80-COLUMN PICTURE }
  46.  
  47.     N_Picture          : N_PictureType Absolute W_Picture;
  48.                                     { THE 40-COLUMN PICTURE }
  49.  
  50.     W_InData           : W_BloadType;
  51.     N_InData           : N_BloadType Absolute W_Indata;
  52.  
  53.     N_InFile           : FILE OF N_BloadType;
  54.     W_InFile           : FILE OF W_BloadType;
  55.  
  56.     N_OutFile          : FILE OF N_PictureType;
  57.     W_OutFile          : FILE OF W_PictureType;
  58.  
  59.     TestFile           : FILE OF Byte;
  60.  
  61.     N_OutPtr           : ^ N_PictureType;
  62.     W_OutPtr           : ^ W_PictureType;
  63.  
  64.  
  65.   FUNCTION Exist (FileName : ParString) : Boolean;
  66.   { SEES IF A FILE EXISTS }
  67.  
  68.     VAR
  69.       TestFile  : FILE;
  70.  
  71.     BEGIN    { Exist }
  72.       Assign (TestFile, FileName);
  73.  
  74. {$I-}
  75.  
  76.       Reset (TestFile);
  77.  
  78. {$I+}
  79.  
  80.       Exist := (IOResult = 0);
  81.       Close (TestFile);
  82.     END;     { Exist }
  83.  
  84.  
  85.  
  86.   PROCEDURE ConvertCase (VAR Strng : ParString);
  87.   { CONVERTS STRINGS TO UPPER CASE }
  88.  
  89.     VAR
  90.       I : Byte;
  91.  
  92.     BEGIN    { ConvertCase }
  93.       FOR I := 1 TO Length (Strng) DO
  94.         Strng [I] := UpCase (Strng [I]);
  95.     END;     { ConvertCase }
  96.  
  97.  
  98.   BEGIN    { Bld_Pic }
  99.     IName := Null;
  100.     IF ParamCount = 0
  101.       THEN
  102.         BEGIN
  103.           Writeln ('Command must be of form: BLD_PIC <name>');
  104.           Exit;
  105.         END;
  106.     IName := ParamStr (1);
  107.     Convertcase (IName);
  108.     OName := IName + PictureExt;
  109.     IName := IName + BloadExt;
  110.     IF NOT Exist (IName)
  111.       THEN
  112.        BEGIN
  113.          Writeln ('ERROR! File not found ' + IName);
  114.          Exit;
  115.        END;
  116.       Assign (TestFile, IName);
  117.       Reset (TestFile);
  118.       Read (TestFile, Code);
  119.       FOR I := 2 TO 6 DO
  120.         Read (TestFile, LowLength); { 6TH AND 7TH BYTES STORE THE LENGTH }
  121.       Read (TestFile, HighLength);
  122.       Size := HighLength * $100 + LowLength;
  123.       Close (TestFile);
  124.       IF (IOResult <> 0) OR (Code <> BloadCode) OR
  125.          NOT (((Size) = TwoKB) OR (Size = FourKB))
  126.         THEN
  127.           BEGIN
  128.             Writeln ('ERROR! File is not of BASIC BLOAD Format.');
  129.             Exit;
  130.           END;
  131.       IF Size = TwoKB
  132.         THEN
  133.           BEGIN
  134.             Assign (N_InFile, IName);
  135.             Reset (N_InFile);
  136.             Read (N_InFile, N_InData);
  137.             N_OutPtr := Ptr (Seg (N_InData), Ofs (N_InData) + 7);
  138.             N_Picture := N_OutPtr ^;   { TRANSFER PICTURE DATA }
  139.             Assign (N_OutFile, OName);
  140.             Rewrite (N_OutFile);
  141.             Write (N_OutFile, N_Picture);
  142.             Close (N_InFile);
  143.             Close (N_OutFile);
  144.           END
  145.         ELSE
  146.           BEGIN
  147.             Assign (W_InFile, IName);
  148.             Reset (W_InFile);
  149.             Read (W_InFile, W_InData);
  150.             W_OutPtr := Ptr (Seg (W_InData), Ofs (W_InData) + 7);
  151.             W_Picture := W_OutPtr ^;       { TRANSFER PICTURE DATA }
  152.             Assign (W_OutFile, OName);
  153.             Rewrite (W_OutFile);
  154.             Write (W_OutFile, W_Picture);
  155.             Close (W_InFile);
  156.             Close (W_OutFile);
  157.           END;
  158.       Writeln ('File '+ OName + ' created.');
  159.     END.     { Bld_Pic }
  160.